home *** CD-ROM | disk | FTP | other *** search
/ Mac Mania 2 / MacMania 2.toast / Demo's / Tools&Utilities / Programming / PowerLisp 1.1 / examples / asm-funcs.lisp next >
Encoding:
Text File  |  1993-02-24  |  3.0 KB  |  155 lines  |  [TEXT/ROSA]
  1. ;
  2. ;        File:        asm-funcs.lisp
  3. ;
  4. ;        Contents:    Sample lisp functions written in assembler.
  5. ;                    These routines may mimic functions used in Common
  6. ;                    Lisp, but they are not the actual functions used 
  7. ;                    by the system. They are provided here as examples
  8. ;                    of how to build such functions.
  9. ;
  10. ;                    These routines are probably faster, and could in
  11. ;                    some cases be used to redefine the system routines
  12. ;                    for improved speed. In general, however, they
  13. ;                    don't do much argument or type checking, which the
  14. ;                    normal routines do.
  15. ;
  16.  
  17. (in-package :user)
  18. (require :assembler)
  19.  
  20. (defasm node-type (x)
  21.     "(NODE-TYPE object)
  22.      Returns the type field from a Lisp object. This is not really equivalent
  23.      to the Lisp type, since the Lisp type contains logical distinctions
  24.      and relationships. This is, however, the physical field used to store
  25.      some of the type information used by the system."
  26. #{
  27.     ($FUNC-BEGIN 0)
  28.     (move.l (a0) a1)
  29.     ($NODE-TYPE a1 d0)
  30.     (move.l d0 (-a7))
  31.     (jsr #'common-lisp::%integerAtom)
  32.     (lea (a7 4) a7)
  33.     ($RETURN d0)
  34. })
  35.  
  36. (defasm consp_ (x)
  37.     "Usage: (CONSP object)
  38.      Returns T if the object is a cons cell, NIL otherwise."
  39. #{
  40.     ($FUNC-BEGIN 0)
  41.     (move.l (a0) a1)
  42.     ($IFELSE
  43.         ($CONSP a1)
  44.         ((move.l 't d0))
  45.         ((move.l 'nil d0)))
  46.     ($RETURN d0)
  47. })
  48.  
  49. (defasm car_ (x)
  50. #{
  51.     ($FUNC-BEGIN 0)
  52.     (move.l (a0) a0)
  53.     ($CAR a0)
  54.     ($RETURN a0)
  55. })
  56.  
  57. (defasm cdr_ (x)
  58. #{
  59.     ($FUNC-BEGIN 0)
  60.     (move.l (a0) a0)
  61.     ($CDR a0)
  62.     ($RETURN a0)
  63. })
  64.  
  65. (defasm rplaca_ (x y)
  66. #{
  67.     ($FUNC-BEGIN 0)
  68.     (move.l (a0) a1)
  69.     ($SETCAR a1 (a0 4))
  70.     ($RETURN a1)
  71. })
  72.  
  73. (defasm rplacd_ (x y)
  74. #{
  75.     ($FUNC-BEGIN 0)
  76.     (move.l (a0) a1)
  77.     ($SETCDR a1 (a0 4))
  78.     ($RETURN a1)
  79. })
  80.  
  81. ;
  82. ;    This is an example of calling a Lisp function from assembler.
  83. ;    In this case 'cons' is called.
  84. ;
  85. (defasm cons_ (a b) 
  86. #{
  87.     ($FUNC-BEGIN 0)
  88.     (move.l 0 (-a7))        ; push NULL terminator
  89.     (move.l (a0 4) (-a7))    ; push second arg
  90.     (move.l (a0) (-a7))        ; push first arg
  91.     (move.l a7 (-a7))        ; push address of block
  92.     (jsr #'cons)            ; call the function
  93.     ($RETURN d0)
  94. })
  95.  
  96. (defasm hundred () 
  97. "The 'hundred' function always returns 100."
  98. #{
  99.     ($FUNC-BEGIN 0)
  100.     (move.l 100 (-a7))
  101.     (jsr #'common-lisp::%integerAtom)
  102.     ($RETURN d0)
  103. })
  104.  
  105. ;;
  106. ;;    Examples of calling toolbox routines via traps.
  107. ;;
  108.  
  109. ;;
  110. ;;     Define these traps in the compiler package
  111. ;;    They should be moved into the assembler module.
  112. ;;
  113. (in-package :assembler)
  114. (defconstant _SysBeep #xA9C8)
  115. (defconstant _Debugger #xA9FF)
  116. (in-package :user)
  117.  
  118. (defasm sysbeep () 
  119. "Usage: (SYSBEEP time) -- where time is an integer.
  120.  Causes a system beep."
  121. #{
  122.     ($FUNC-BEGIN 0)
  123.     (move.l (a0) a1)
  124.     ($INTEGER a1 (-a7))
  125.     (dc.w _SysBeep)        ;; this trap cleans up the stack itself
  126.     ($RETURN 'nil)        ;; return nil
  127. })
  128.  
  129.  
  130. (defasm debugger () 
  131. "Usage: (DEBUGGER)
  132.  Drops you into the mac debugger (MacsBug, for example)."
  133. #{
  134.     ($FUNC-BEGIN 0)
  135.     (dc.w _Debugger)
  136.     ($RETURN 'nil)
  137. })
  138.  
  139. (defasm i+ (x y) 
  140. #{
  141.     ($FUNC-BEGIN 0)
  142.     (move.l (a0 4) a1)
  143.     ($INTEGER a1 d0)
  144.     (move.l (a0) a1)
  145.     ($INTEGER a1 a1)
  146.     (add.l a1 d0)    
  147.     (move.l d0 (-a7))
  148.     (jsr #'common-lisp::%integerAtom)
  149.     ($RETURN d0)
  150. })
  151.  
  152. ;; note that ( add.l d1 d0 ) is broken!!!
  153.  
  154.  
  155.